home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / elecCompletion.tcl < prev    next >
Encoding:
Text File  |  1998-12-16  |  17.1 KB  |  472 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "elecCompletion.tcl"
  6.  #                  created: 8/3/96 {12:06:40 pm}    
  7.  #                  last update: 16/12/1998 {1:45:54 am}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #  modified by  rev reason
  15.  #  -------- --- --- -----------
  16.  #  8/3/96   VMD 1.0 original
  17.  #  20/11/96 VMD 1.1 many, many improvements.
  18.  #  24/2/97  VMD 1.2 added some support of trf's code, plus some fixes
  19.  #  1/9/97   VMD 1.5 added 'completion::contraction' and improved g-elec.
  20.  #  12/1/97  trf 1.6 added 'Tutorial Shell' stuff, bumped to 9.0b2
  21.  #  12/2/97  trf 1.7 corrected corrections, bumped to 9.0b3
  22.  #  4/12/97  VMD 1.8 various fixes, better tcl8 compatibility
  23.  # ###################################################################
  24.  ##
  25.  
  26. alpha::extension elecCompletions 9.0 {
  27.     alpha::package require elecBindings 9.0
  28.     alpha::package require -loose Alpha 7.1b5
  29.     menu::insert mode items end "completionsTutorial" "editCompletions" 
  30.     # load completion code for a mode the first time that mode is used
  31.     hook::register mode::init completion::load "*"
  32.     namespace eval completion {}
  33.     completion::initialise
  34. } maintainer {
  35.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  36. } uninstall this-file help {file "ElecCompletions Help"}
  37.  
  38. proc completion::initialise {} {}
  39.  
  40. namespace eval elec {}
  41.  
  42. proc completion::load {} {
  43.     global HOME
  44.     foreach f [glob -nocomplain [file join ${HOME} Tcl Completions [modeALike]Completions*.tcl]] {
  45.     message "loading [file tail $f]…"
  46.     namespace eval ::[modeALike]::Completion {}
  47.     uplevel \#0 [list source $f]
  48.     }
  49. }
  50.  
  51. ## 
  52.  # -------------------------------------------------------------------------
  53.  # 
  54.  #    "completion::cmd"    --
  55.  # 
  56.  #     General purpose proc for extending    a given    command    to its full    extent
  57.  #     in    a mode-dependent fashion.  If we hit a unique match, we    call
  58.  #     '${mode}completion::Electric'; if we    can    extend,    we do so, and set things up
  59.  #     so    the    calling    procedure '${mode}completion::Cmd' will be called    if
  60.  #     the user tries    to cmd-Tab again; if we    don't recognise    anything,
  61.  #     we    return 0
  62.  #     
  63.  #     We    normally use the list ${m}cmds to look for completions,    but    the
  64.  #     caller    can    supply a different name.  This is useful to    prioritise
  65.  #     lists,    so we first    call with one, then    another,...     I currently use
  66.  #     this feature for TeX-completions, in which    I call with    a second list,
  67.  #     containing    fake commands, which expand    into environments.
  68.  # -------------------------------------------------------------------------
  69.  ##
  70. proc completion::cmd { {cmd ""} {listExt "cmds"} {prematch ""}} {
  71.     if ![string length $cmd] { 
  72.     set cmd [completion::lastWord]
  73.     # if there's any whitespace in the command then it's no good to us
  74.     if [containsSpace $cmd] { return 0 }
  75.     }
  76.     
  77.     set m [modeALike]
  78.     # do an electric if we already match exactly
  79.     global ${m}electrics
  80.     if [info exists ${m}electrics($cmd)] {
  81.     return [completion ${m} Electric "${prematch}${cmd}"]
  82.     }
  83.     if { [set matches [completion::fromList $cmd ${m}${listExt}]] == "" } {
  84.     return 0
  85.     } else {
  86.     return [completion::matchUtil Cmd $cmd $matches $prematch]
  87.     }
  88. }
  89.  
  90. proc completion::matchUtil {proc what matches {prematch ""}} {
  91.     if {$matches == ""} { return 0 }
  92.     set match [completion::Find $what $matches]
  93.     if [string length $match] {
  94.     # we completed or cancelled, so move on
  95.     #completion::already error
  96.     if { $match == 1 } {
  97.         return 1
  98.     } else {
  99.         return [completion [modeALike] Electric "${prematch}${match}"]
  100.     }
  101.     } else {
  102.     completion::already $proc
  103.     return 1
  104.     }
  105. }
  106.  
  107. ## 
  108.  # -------------------------------------------------------------------------
  109.  #     
  110.  # "completion::ensemble"    --
  111.  #    
  112.  #    Complete and do    electrics for commands which have two parts    separated
  113.  #    by a space.     Very useful for Tcl's "string compare ..."    etc.
  114.  # -------------------------------------------------------------------------
  115.  ##
  116. proc completion::ensemble {dummy} {
  117.     set lastword [completion::lastTwoWords prevword]
  118.     set prevword [string trim $prevword]
  119.     set m [modeALike]
  120.     global ${m}${prevword}cmds
  121.     if [info exists ${m}${prevword}cmds] {
  122.     return [completion::cmd $lastword "${prevword}cmds" "${prevword} "]
  123.     } else {
  124.     return 0
  125.     }
  126. }
  127.  
  128.  
  129. ## 
  130.  # -------------------------------------------------------------------------
  131.  #     
  132.  #    "completion::fromList" --
  133.  #    
  134.  #     Given a 'cmd' prefix and the name of a    list to    search,    that list
  135.  #     being stored in alphabetical order    and    starting/ending    with 
  136.  #     whitespace, this proc returns a list of all matches with 'cmd',
  137.  #     or    ""    if there were none.  Updated so works with arrays too (Nov'96)
  138.  #     
  139.  #     It's quite an important procedure for completions, and must handle
  140.  #     pretty large lists, so it's worth optimising.
  141.  #     
  142.  #     Note '\\b' = word boundary, '\\s' = whitespace '\\S' = not-whitespace
  143.  # -------------------------------------------------------------------------
  144.  ##
  145. if {[info tclversion] < 8.0} {
  146. proc completion::fromList { __cmd slist } {
  147.     global [lindex [split $slist "\("] 0]
  148.     if [regexp "(^| )(${__cmd}\[^\\S\]*\\b\\s*)+" [set "$slist"] matches] {
  149.     return [string trim $matches]
  150.     } else {
  151.     return ""
  152.     }
  153. }
  154. } else {
  155. proc completion::fromList { __cmd slist } {
  156.     global [lindex [split $slist "\("] 0]
  157.     regexp {^(.*)(.)$} $__cmd "" _find _last    
  158.     set _find "^[quote::Regfind $_find]\[^$_last\].*"
  159.     set first [lsearch -glob [set $slist] "${__cmd}*"]
  160.     if {$first == -1} { return "" }
  161.     set first [lrange [set $slist] $first end]
  162.     set last [lsearch -regexp $first $_find]
  163.     if {$last == -1} { return $first }
  164.     return [lrange $first 0 [incr last -1]]
  165. }
  166. }
  167.  
  168. ## 
  169.  # -------------------------------------------------------------------------
  170.  #     
  171.  #    "completion::electric" --
  172.  #    
  173.  #     Given a command, and an optional list of defaults,    check the command
  174.  #     is    ok and if so try and insert    an electric    entry.
  175.  # -------------------------------------------------------------------------
  176.  ##
  177. proc completion::electric { {cmd ""} args } {
  178.     set m [modeALike]
  179.     if ![string length $cmd] { 
  180.     set cmd [completion::lastWord] 
  181.     # only check for space if we're doing it
  182.     if [containsSpace $cmd] { return 0 }
  183.     }
  184.     
  185.     return [eval [list elec::findCmd $cmd ${m}electrics] $args]
  186. }
  187.  
  188. ## 
  189.  # -------------------------------------------------------------------------
  190.  #     
  191.  # "completion::contraction"    --
  192.  #    
  193.  #    Complete and do    electrics for commands which have two parts    separated
  194.  #    by a apostrophe.   Useful for making shortcuts to things. ex: s'c Tcl's 
  195.  #    "string compare ..."    etc.
  196.  # -------------------------------------------------------------------------
  197.  ##
  198. proc completion::contraction {dummy} {
  199.     set lastword [completion::lastTwoWords hint]
  200.     if {![regexp "'\$" $hint]} {return 0}
  201.     append hint $lastword
  202.     return [completion::electric $hint]
  203. }
  204.  
  205. ## 
  206.  # -------------------------------------------------------------------------
  207.  # 
  208.  #    "elec::findCmd" --
  209.  # 
  210.  #     General purpose proc for extending    a command in some predetermined    
  211.  #     fashion (such as mapping 'for'    to a template 'for (;;)…').     Mode specific 
  212.  #     procedures    may    use    this if    desired.  The given    command    is looked up in    
  213.  #     the given array '$arrayn',    and    if there is    an entry, some electric    
  214.  #     procedure happens.     By    default, if    an entry is    '0', then '0' is returned 
  215.  #     (which    can    be used    by the calling procedure to    take some other    action,    
  216.  #     usually more sophisticated    such as    TeX-ref- completion), and if the entry 
  217.  #     is    an integer corresponding to    a list element of the list 'args', then    
  218.  #     that element is inserted.    In this    case list elements start with '1' 
  219.  #     (because zero has a special meaning).    Template stops in the electric 
  220.  #     completion    are    marked by pairs    of bullets '••'.  If there is any text 
  221.  #     between the bullets, that can be used to inform the user of what ought    to 
  222.  #     go    there.    All    strings    must contain at    least one such template    stop, to 
  223.  #     which the insertion point moves.
  224.  # 
  225.  #    '$arrayn' ought    not    to be a    large array    or this    proc may be slow.
  226.  #  (we first look for an exact array element match $arrayn($cmd), but
  227.  #  if that fails we look for a glob'ed match)
  228.  #  
  229.  #  The array element may contain control sequences.  These start with
  230.  #  '◊', and may be followed by:
  231.  #  
  232.  #  kill0 --- delete the string which triggered this template before
  233.  #            inserting anything.
  234.  #            
  235.  #  killN --- delete all except N characters of the string.
  236.  #  
  237.  #  N --- use the N'th element of 'args' for the template.
  238.  #  
  239.  #  [ --- the string must be evaluated first (usually triggering some proc
  240.  #        which perhaps interacts with the user a bit)
  241.  #  
  242.  #  » --- an indirection; use the template insertion corresponding to
  243.  #        the given text item instead.
  244.  #        
  245.  #  In order to provide backward compatiblity of this proc with any new 
  246.  #  control sequences that may be developed, any 'unknown' control 
  247.  #  sequence is just deleted, a package that deals with the new sequences 
  248.  #  thus has to overide this proc in order to make the now sequences 
  249.  #  functionality available.
  250.  #  
  251.  #  So, what are some of the possible future control sequences? Well, I've 
  252.  #  played with;
  253.  #  
  254.  #                 sequences bound to a stop
  255.  #  
  256.  #  « --- an extended prompt, provides a longer, more pedalogical explanation 
  257.  #        for a stop that the curt, fill in 'xxx' in the statusline.
  258.  #  ¶ --- a name that acts as an index into an array of code snippets, so a 
  259.  #        bit of code can be executed when visiting a stop, perhaps aiding 
  260.  #        in filling in options, validating entries, or anything else that 
  261.  #        makes sense.
  262.  #  ø --- marks a stop of such an obvious nature, that the marking of the 
  263.  #        stop with a dot, or and in-text prompt is superflous. In fact, such 
  264.  #        stops often have existing statements dragged into their position, 
  265.  #        so leaving them unmarked has a speed advantage. Perhaps this 
  266.  #        action is best toggled depending on a flag value.
  267.  #        
  268.  #     Any stop that falls in the above class, will occur after any regular 
  269.  #     prompting text, and should trigger the removal of itself and any 
  270.  #     other characters up until the occurrence of the stop ending bullet. 
  271.  #     That can be acomplished in one of two ways, here with a regsub of this 
  272.  #     form:
  273.  #     regsub -all {•([^◊]*)◊[^•]+•} <template> {•\1•} result 
  274.  #     or by applying the regsub to the entire set of electrics for a mode 
  275.  #     as soon as its completions are loaded. (first method implemented)
  276.  #        
  277.  #                 sequences that occurr at the start of a template
  278.  #                     and apply to the template as a whole
  279.  #  
  280.  #  < --- means that certain conditions that must be meet by the text 
  281.  #        proceeding where this template is to be inserted must be met 
  282.  #        before the insertion is allowed, (e.g. a tcl command must be 
  283.  #        proceeded by whitespace, a [, a ", or eval for the insertion 
  284.  #        to be syntactically correct and thus , allowable)
  285.  #        
  286.  #     Sequences in this class will have to be of a single character, as 
  287.  #     will get rid of any unknown sequence by
  288.  #     resub {◊[^k0-9»\[]} [string range <template 0 [string first • <template>]] head
  289.  #     set <template> $head
  290.  #     append <template> rest
  291.  #
  292.  #  Includes some fixes by Tom Fetherston
  293.  # -------------------------------------------------------------------------
  294.  ##
  295. proc elec::findCmd { cmd arrayn args } {
  296.     if {[set action [elec::_findCmd $cmd $arrayn]] == ""} { return 0 }
  297.     # we have the action; check for control sequences
  298.     while {[string index $action 0] == "◊"} {
  299.     # control sequence: kill, procedure or choice of default value?
  300.     set action [string range $action 1 end]
  301.     if { [string range $action 0 3] == "kill" } {
  302.         set dpos [pos::math [getPos] - [expr [string length $cmd] + [string index $action 4]]] 
  303.         deleteText $dpos [getPos]
  304.         regsub -all "kill" [string range $action 5 end] $cmd action
  305.     } elseif {[string index $action 0] == "\[" } {
  306.         set action [subst $action]
  307.     } elseif {[string index $action 0] == "»" } {
  308.         set key [string range $action 1 end]
  309.         global $arrayn
  310.         set text [set ${arrayn}($key)]
  311.         set action "◊kill0${key}${text}" 
  312.     } elseif {([scan $action %d idx]) \
  313.       && (![ catch {lindex $args [expr $idx-1]} act]) } {
  314.         set action $act
  315.     } else {
  316.         if {[info commands [set proc elec::action::[string index $action 1]]] == $proc} {
  317.         set action [$proc $action]
  318.         } else {
  319.         set action [string range $action 2 end]
  320.         }
  321.     }
  322.     }
  323.     # then, we pull out any "bulleted-stop control sequences" that are 
  324.     # unknown to this version of elec::findCmd -trf
  325.     regsub -all {•([^◊]*)◊[^•]+•} $action {•\1•} action 
  326.     elec::Insertion $action
  327.     # The idea here is to continue with other completions (return 0)
  328.     # if the character before the insertion point is non white-space
  329.     global wordBreakPreface
  330.     if {![regexp $wordBreakPreface [lookAt [pos::math [getPos] - 1]]]} {
  331.     if [isSelection] {deleteText [getPos] [selEnd]}
  332.     return 0
  333.     } else {
  334.     return 1
  335.     }
  336. }
  337.  
  338. ## 
  339.  # -------------------------------------------------------------------------
  340.  # 
  341.  # "elec::_findCmd" --
  342.  # 
  343.  #  Find the electric command in the given array, or return ""
  344.  # -------------------------------------------------------------------------
  345.  ##
  346. proc elec::_findCmd {cmd arrayn} {
  347.     global $arrayn
  348.     if [info exists ${arrayn}($cmd)] {
  349.     return [set "${arrayn}($cmd)"]
  350.     } else {
  351.     if {[string first "*" [set elec_ar [array names $arrayn]]] != -1 } {
  352.         # some of the array matches are glob'ed; we must go one at a time
  353.         foreach elec $elec_ar {
  354.         if [string match $elec $cmd] {
  355.             return [set "${arrayn}($elec)"]
  356.         }
  357.         }
  358.     }
  359.     }
  360.     return ""
  361. }
  362.  
  363. # just so we have one!
  364. set userCompletions(date) {◊kill0◊[lindex [mtime [now]] 0]}
  365.  
  366. # ensure old version loaded:
  367. catch "completion::user"
  368. ## 
  369.  # -------------------------------------------------------------------------
  370.  # 
  371.  # "completion::user" --
  372.  # 
  373.  #   A user completion is used for small
  374.  #     mode-independent snippets, like your email address, name etc.
  375.  #     For instance I have the following defined:
  376.  #     
  377.  #     set userCompletions(vmd) "◊kill0Vince Darley"
  378.  #   set userCompletions(www) "◊kill0<[icGetPref WWWHomePage]>"
  379.  #   set userCompletions(e-) "◊kill0<[icGetPref Email]>"
  380.  #   
  381.  #   Here '◊kill0' is a control sequence which means kill exactly what
  382.  #   I just typed before carrying out this completion.
  383.  # -------------------------------------------------------------------------
  384.  ##
  385. proc completion::user { {cmd ""} } {
  386.     if ![string length $cmd] { set cmd [completion::lastWord] }
  387.     if [containsSpace $cmd] { return 0 }
  388.     
  389.     return [elec::findCmd $cmd userCompletions]    
  390. }
  391.  
  392. proc mode::completionsTutorial {} {
  393.     global HOME
  394.     set f [file join ${HOME} Tcl Completions "[modeALike] Tutorial"]
  395.     set files [glob -nocomplain $f*]
  396.     if {[llength $files] == 1} {
  397.     set fName [lindex $files 0]
  398.     set mode [file::whichModeForWin "dummy[file extension $fName]"]
  399.     set t [file::readAll $fName]
  400.     new -n "*Tutorial shell*" -m $mode
  401.     setWinInfo shell 1
  402.     insertText $t
  403.     unset t
  404.     goto [minPos]
  405.     Bind '`' vsp $mode
  406.     } else {
  407.     alertnote "No tutorial exists for this mode.  Why don't you write one?"
  408.     }
  409. }
  410.  
  411. proc vsp {} {
  412.     if {[win::Current] != "*Tutorial shell*"} {
  413.     typeText "`"
  414.     return
  415.     } 
  416.     searchString "◊" 
  417.     goto [pos::math [getPos] + 2] 
  418.     findAgain
  419.     centerRedraw
  420.     if [isSelection] {
  421.     deleteText [getPos] [selEnd]
  422.     # add the following to prevent the 'non-use' of a template from
  423.     # messing up the next completion
  424.     ring::clear
  425.     }    
  426. }
  427.  
  428. proc mode::editCompletions {} {
  429.     global HOME
  430.     set f [file join ${HOME} Tcl Completions [modeALike]Completions.tcl]
  431.     if [catch {file::openQuietly $f}] {
  432.     beep
  433.     if {[askyesno "No completions exist for this mode. Do you want to create some?"] == "yes"} {
  434.         set fd [open $f "w"]
  435.         close $fd
  436.         edit $f
  437.         insertText {## 
  438.  # This file will be sourced automatically, immediately after 
  439.  # the _first_ time the file which defines its mode is sourced.
  440.  # Use this file to declare completion items and procedures
  441.  # for this mode.
  442.  # 
  443.  # Some common defaults are included below.
  444.  ##
  445.  
  446. ## 
  447.  # These declare, in order, the names of the completion
  448.  # procedures for this mode.  The actual procedure
  449.  # must be named '${mode}Completion::${listItem}', unless
  450.  # the item is 'completion::*' in which case that actual
  451.  # procedure is called.  The procedure 'modeALike' will
  452.  # map modes to similar modes so procs don't need to be
  453.  # repeated.  However each mode requires its own array entry
  454.  # here.
  455.  ##
  456. set completions(<mode>) {contraction completion::cmd Ensemble completion::electric Var}
  457.  
  458. }\
  459.  {# ◊◊◊◊ Data for <mode> completions ◊◊◊◊ #
  460.  
  461. # cmds to be completed to full length (no need for short ones)
  462. set <mode>cmds { class default enum register return struct switch typedef volatile while }
  463. # electrics
  464. set <mode>electrics(for) " \{•start•\} \{•test•\} \{•increment•\} \{\r\t•body•\r\}\r••"
  465. set <mode>electrics(while) " \{•test•\} \{\r\t•body•\r\}\r••"
  466. # contractions
  467. set <mode>electrics(s'c) "◊»string compare"
  468. set <mode>electrics(s'f) "◊»string first"
  469. }}}            
  470. }
  471.  
  472.